home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / dir.arc / DIR.PAS next >
Pascal/Delphi Source File  |  1991-04-28  |  28KB  |  674 lines
  1. Unit Dir ;
  2.  
  3. { This unit will give you a pop-up window with a list of files in the current
  4.     subdirectory.  If you are in the root directory, then it will also give a
  5.     list of the current disk drives available, and allow the user to log on to
  6.     any available drives.  There are two routines implemented that you can
  7.     easily integrate into your own programs.
  8.  
  9.  1) The first routine obtains a list of all files in the current directory.  It
  10.     excludes hidden, system, and volume files, as well as the '.' file.  The
  11.     files are kept in the heap in a series of records of type SearchRec.  The
  12.     array FilPtrs contains pointers into the heap to find the appropriate
  13.     record.  Usage of GetFileList is simple:
  14.  
  15.        GetFileList (PathName) ;      (* get file list for named directory *)
  16.           or
  17.        GetFileList (FExpand('')) ;   (* get file list for current directory *)
  18.  
  19.     Either one will get the files in the current or named directory and put
  20.     them into the heap, with FilPtrs pointing the way.  You can find the last
  21.     entry in FilPtrs by either searching for a NIL pointer, or accessing the
  22.     last one through FilPtrs [TotalDirFiles].  You do not need to ever call
  23.     this routine by itself unless you want to perform your own file management
  24.     as DisplayList calls this routine internally.  It is available if you need
  25.     it though.
  26.  
  27.  2) The second routine is DisplayList (wt,wl,wh,ww,FilName).  DisplayList
  28.     automatically calls GetFileList, so you do not need to call GetFileList
  29.     first.  To use it, you must pass it five parameters:
  30.  
  31.        wt       : the top row of the top of the directory window
  32.        wl       : the left column of the side of the directory window
  33.        wh       : the number of rows in the directory window
  34.        ww       : the number of columns in the directory window
  35.        FilName  : the variable name for the selected file
  36.  
  37.     Usage is also quite simple:
  38.  
  39.        DisplayList (wt,wl,wh,ww,FilName) ;
  40.  
  41.     The four window coordinates must be variables and not constants as
  42.     DisplayList allows the user to move the window around, and remembers the
  43.     last location for the window.  Before you call DisplayList for the first
  44.     time, you MUST call the InitWindow routine first, or be prepared for weird
  45.     results.
  46.  
  47.     Operation is very simple and intuitive (I hope).  The user uses the arrow
  48.     keys, PgUp, PgDn, Home, and End keys for moving the file selector bar
  49.     around, and the Enter or Return key to either select a file, or to select
  50.     another drive/directory.  Ctrl+arrow keys moves the window, and Alt+arrows
  51.     resizes the window.  When all else fails, press F1 for help with the keys.
  52.  
  53. Note: This program uses the Quik and Wndw screen and windowing packages
  54.     from Eagle Performance Software, and you must have these units available
  55.     to use Dir.  These packages are shareware and may be downloaded from their
  56.     BBS at (214) 539-9878,  1200/2400 N81.
  57.  
  58.     This software also requires the drivefnd, extrados, and keyboard units
  59.     which are supplied as part of the package.
  60.  
  61.  
  62.     This software is copyright (c) 1990 by Michael Courtney.  It may be used by
  63.     anyone as long as it remains intact and without modification.  There are
  64.     no royalties needed, and it may be freely distributed and copied as long
  65.     as no charges are levied for its distribution, other than the actual cost
  66.     of distribution.
  67.  
  68.     Michael Courtney
  69.     (714) 893-8165
  70.  
  71. HISTORYhistoryHISTORYhistoryHISTORYhistoryHISTORYhistoryHISTORYhistoryHISTORY
  72.  
  73.    04Aug90 M. Courtney - Created version 1.0
  74.  
  75. HISTORYhistoryHISTORYhistoryHISTORYhistoryHISTORYhistoryHISTORYhistoryHISTORY}
  76.  
  77. Interface
  78.  
  79. uses dos, Qwik, Wndw, Strs, Goof;
  80.  
  81. Procedure GetFileList (PathName: string) ;
  82. Procedure DisplayList (var wt,wl,wh,ww: integer; var FilName: string) ;
  83.  
  84. type
  85.    SRecP           = ^SearchRec ;      { pointer to a file name }
  86.  
  87. var
  88.    FilPtrs         : Array[0..999] of SRecP ;  { array of pointers to file names }
  89.    TotalDirFiles   : integer ;         { total number of files in given dir }
  90.  
  91. Implementation
  92.  
  93. uses crt, drivefnd, extrados, keyboard ;
  94.  
  95. var
  96.    GoodKey         : Boolean ;
  97.    Sub             : string[11] ;
  98.  
  99.  
  100. Procedure ShowErrorMessage(ErrorMessage:String) ;
  101.    { General error message display pop-up window }
  102.  
  103. begin
  104.    SetWindowModes(ZoomMode+ShadowRight+CursorOffMode) ;
  105.    MakeWindow(18,0,5,Length(ErrorMessage)+4,Yellow+RedBG,White+RedBG,SingleBrdr,aWindow) ;
  106.    With TopWndwStat do begin
  107.       WndwAttr := Blink+White+RedBG ;
  108.       WWriteC (1,ErrorMessage) ;
  109.       WndwAttr := OrigAttr ;
  110.       end ;
  111.    WWriteC (2,'Press any key') ;
  112.    WWriteC (3,'to continue...') ;
  113.    Key := Readkey ;
  114.    RemoveWindow ;
  115. end ;
  116.  
  117.  
  118. Procedure ReleaseFilePtrs ;
  119.    { release the file pointers off of the heap in the last directory }
  120.  
  121.    var
  122.       i               : integer ;
  123.  
  124. begin
  125.    i := 1 ;
  126.    While (FilPtrs[i] <> nil) do begin
  127.       Dispose(FilPtrs[i]) ;
  128.       inc(i) ;
  129.       end ;
  130. end ;
  131.  
  132.  
  133. Procedure GetFileList (PathName: string) ;
  134.    { get a list of files in the current directory }
  135.  
  136.    var
  137.       FileP           : SRecP ;       { a pointer to a file name }
  138.       DirInfo         : SearchRec ;   { file data, name, date, attrib, etc }
  139.       i,j             : integer ;
  140.       TempStr,
  141.       TempSt2         : string[80] ;
  142.  
  143. begin
  144.    i := 1 ;                            { init file pointer counter }
  145.    j := 1 ;                            { init disk drive counter }
  146.    if copy(PathName,3,80) = '\' then begin  { if in root directory }
  147.       While (j < NumbDrives+1) do begin              { for all drives }
  148.          if copy(PathName,1,1) <> Drives[j] then begin  { don't list current drive }
  149.             New(FileP) ;                 { create heap space for drive data }
  150.             FilPtrs[i] := FileP ;        { put pointer to disk drive pointer }
  151.             with DirInfo do begin        { assign data to drive for rest of program }
  152.                Name := Drives[j] + ':';  {   'file' name is drive name }
  153.                Attr := Directory ;       {   'attribute' is directory }
  154.                end ;
  155.             FilPtrs[i]^ := DirInfo ;     { save drive data in the heap }
  156.             inc(i) ;                     { inc to next heap pointer }
  157.             end ;
  158.          inc(j) ;                        { inc to next drive }
  159.          end ;
  160.       end ;
  161.    New(FileP) ;                       { create heap space for first file in directory }
  162.    FilPtrs[i] := FileP ;              { put pointer to first file in pointer array }
  163.    FindFirst('*.*',AnyFile,DirInfo) ; { anyfile is included }
  164.    While (DirInfo.Name = '.') OR
  165.       ((DirInfo.Attr AND VolumeID) <> 0) OR
  166.       ((DirInfo.Attr AND Hidden)   <> 0) OR
  167.       ((DirInfo.Attr AND SysFile)  <> 0) do FindNext(DirInfo) ;
  168.    FilPtrs[i]^ := DirInfo ;           { put the file data on the heap where pointer points }
  169.  
  170.    { Get rest of files in directory }
  171.    While (DosError = 0) AND (FileP <> Nil) do begin
  172.       FindNext(DirInfo) ;
  173.       if ((DirInfo.Attr AND VolumeID) = 0) AND
  174.          ((DirInfo.Attr AND Hidden)   = 0) AND
  175.          ((DirInfo.Attr AND SysFile)  = 0) then begin
  176.          inc(i) ;
  177.          New(FileP) ;
  178.          FilPtrs[i] := FileP ;
  179.          FilPtrs[i]^ := DirInfo ;
  180.          end ;
  181.       end ;
  182.    TotalDirFiles := i-1 ;       { Total number of files found in this directory }
  183.    FilPtrs[i] := nil ;          { mark last + 1 as nil for end point }
  184. end ;
  185.  
  186.  
  187. Function MinI(Value1,Value2:integer) : integer ;
  188.  
  189. begin
  190.    If Value1 < Value2 then MinI := Value1
  191.                       else MinI := Value2 ;
  192. end ;
  193.  
  194.  
  195. Function MaxI(Value1,Value2:integer) : integer ;
  196.  
  197. begin
  198.    If Value1 > Value2 then MaxI := Value1
  199.                       else MaxI := Value2 ;
  200. end ;
  201.  
  202.  
  203. Procedure VerifyParamters (var wt,wl,wh,ww: integer) ;
  204.    { verify that the parameters passed to DisplayList are ok }
  205.  
  206. begin
  207.    wt := MinI(wt,22) ;
  208.    wl := MinI(wl,62) ;
  209.    wh := MinI(wh,25) ;
  210.    ww := MinI(ww,50) ;
  211.  
  212.    wt := MaxI(wt,1) ;
  213.    wl := MaxI(wl,1) ;
  214.    wh := MaxI(wh,3) ;
  215.    ww := MaxI(ww,16) ;
  216. end ;
  217.  
  218.  
  219. Procedure DisplayList (var wt,wl,wh,ww: integer; var FilName: string) ;
  220.    { display list of files found by GetFileList }
  221.  
  222.    var
  223.       FileOffset,                    { first file in directory shown on screen }
  224.       FNum            : integer ;    { number of files displayed }
  225.       DT              : DateTime ;
  226.       Attribute       : String[2] ;
  227.       M               : String[12] ;
  228.  
  229.  
  230.    Procedure GetSubName (FileName : string) ;
  231.       { find name of the current subdirectory }
  232.  
  233.       var
  234.          P               : PathStr ;
  235.          D               : DirStr ;
  236.          N               : NameStr ;
  237.          E               : ExtStr ;
  238.          i               : integer ;
  239.  
  240.    begin
  241.       if FileName <> '' then begin
  242.          FSPlit(FileName,D,N,E) ;
  243.          i := length (D) - 1 ;
  244.          While (D[i] <> '\') AND (i >= 0) do dec(i) ;
  245.          if (i > 0) then Sub := copy(D,i+1,length(D)-i-1)
  246.                     else Sub := '' ;
  247.          end ;
  248.    end ;
  249.  
  250.  
  251.    Function SubOffset : integer ;
  252.       { find subroutine offset in display list }
  253.  
  254.       var
  255.          i              : integer ;
  256.  
  257.    begin
  258.       i := 0 ;
  259.       Repeat
  260.          inc(i) ;
  261.       Until (i >= wh-2) OR (i >= TotalDirFiles) OR (FilPtrs[i]^.Name = Sub) ;
  262.       if (FilPtrs[i]^.Name = Sub) then SubOffset := i
  263.                                   else SubOffset := 1 ;
  264.    end ;
  265.  
  266.  
  267.    Procedure DisplayOne (row,i : integer) ;
  268.       { display one file in the current directory on the screen }
  269.  
  270.       var
  271.          TempStr    : string[16] ;
  272.          TempNum    : integer ;
  273.  
  274.    begin
  275.       with FilPtrs[i]^ do begin
  276.          UnpackTime(Time,DT) ;
  277.          with DT do begin                     { for parent directory }
  278.             If Pos('..',Name) > 0 then Wwrite(Row,2,Copy(Name + '            ',1,12))
  279.             else begin                        { look for dot before extension }
  280.                If Pos('.',Name) > 0 then M := Copy(Name,1,Pos('.',Name)-1)
  281.                                     else M := Copy(Name,1,8) ;
  282.                WWrite(Row,2,Copy(M + '        ',1,8)) ;  { write the file name }
  283.                { now write out the extension }
  284.                If Pos('.',Name) > 0 then QWriteEOS(SameAttr,Copy(Copy(Name,Pos('.',Name),4)+'   ',1,4))
  285.                                     else QWriteEOS(SameAttr,'    ') ;
  286.                end ; {else-begin}
  287.             if (Pos(':',Name) = 0) then begin
  288.                if (Attr = Directory) then QWriteEOS(SameAttr,'   <Dir>')
  289.                else
  290.                   if Size <= 9999999 then begin
  291.                      Str(Size:8,TempStr) ;         { if will fit in space }
  292.                      QWriteEOS(SameAttr,TempStr) ;
  293.                      end
  294.                   else begin
  295.                      Str((Size/1024):6:0,TempStr) ; { if won't fit in space }
  296.                      QWriteEOS(SameAttr,TempStr + ' M') ;
  297.                      end ;
  298.                Str(Month:4,TempStr) ;
  299.                QWriteEOS(SameAttr,TempStr+'/') ;
  300.                Str(Day:2,TempStr) ;
  301.                QWriteEOS(SameAttr,TempStr+'/') ;
  302.                Str(Year:4,TempStr) ;
  303.                QWriteEOS(SameAttr,TempStr) ;
  304.                TempNum := (Hour mod 12) ;
  305.                If (TempNum = 0) then TempNum := 12 ;
  306.                Str(TempNum:5,TempStr) ;
  307.                QWriteEOS(SameAttr,TempStr+':') ;
  308.                Str(Min,M) ;
  309.                M := Copy('0'+M,length(M),2) ;
  310.                if Hour < 12 then M := M + 'a'
  311.                             else M := M + 'p' ;
  312.                QWriteEOS(SameAttr,M) ;
  313.                Attribute := '..' ;
  314.                if ((Attr AND ReadOnly) <> 0) then Attribute[1] := 'R' ;
  315.                if ((Attr AND Archive ) <> 0) then Attribute[2] := 'A' ;
  316.  
  317. { Use these only if you want to display these attributes and change the length
  318.     of the Attribute string.
  319.  
  320.                if ((Attr AND Hidden    ) <> 0) then Attribute[ ] := 'H' ;
  321.                if ((Attr AND SysFile   ) <> 0) then Attribute[ ] := 'S' ;
  322.                if ((Attr AND VolumeID  ) <> 0) then Attribute[ ] := 'V' ;
  323.                if ((Attr AND Directory ) <> 0) then Attribute[ ] := 'D' ;
  324. }
  325.                WWrite(Row,46,Attribute) ;
  326.                end ;
  327.           end ; {with}
  328.       end ; {with}
  329.    end ;
  330.  
  331.  
  332.    Procedure DisplaySome (FirstFileOffset :integer) ;
  333.       { display either the entire directory, or a screenful depending on
  334.            how many files there are }
  335.  
  336.       var
  337.          i       : integer ;            { file offset counter }
  338.  
  339.    begin
  340.       i := FirstFileOffset ;         { start at file offset passed to routine }
  341.       FNum := 0 ;                    { count number of files displayed to not overrun window }
  342.       While (FNum <= wh-3) AND (FilPtrs[i] <> nil) do begin
  343.          inc(FNum) ;
  344.          DisplayOne(FNum,i) ;              { display data for next file }
  345.          if (FNum <= wh-3) then QEosLn ;   { cr except at last line }
  346.          inc(i) ;                          { increment file counter to next file }
  347.          end ;
  348.       VUpdateWindow ;
  349.    end ;
  350.  
  351.  
  352.    Procedure ScrollUp ;
  353.       { scroll the file list up by one file }
  354.  
  355.    begin
  356.       WDelLine(1) ;                  { delete the top line and scroll others up }
  357.       inc(FileOffset) ;              { start next display at next file }
  358.       WGotoRC(wh-2,1) ;              { next file goes at bottom of list }
  359.       DisplayOne (wh-2,FileOffset+wh-3) ; { display next file data }
  360.    end ;
  361.  
  362.  
  363.    Procedure ScrollDown ;
  364.       { scroll the file list down by one file }
  365.  
  366.    begin
  367.       WInsLine(1) ;                  { insert a blank line at top, and scroll other down one }
  368.       dec(FileOffset) ;              { start next display at previous file }
  369.       WGotoRC(1,1) ;                 { next file goes at top of list }
  370.       DisplayOne (1,FileOffset) ;    { display next file data }
  371.    end ;
  372.  
  373.  
  374.    Procedure DirectoryHelp ;
  375.       { display a help window when the F1 key is pressed }
  376.  
  377.       var
  378.          temp            : string[80] ;
  379.          key             : char ;
  380.          Row,
  381.          Col             : integer ;
  382.  
  383.    begin
  384.       Row := WWhereR ;
  385.       Col := WWhereC ;
  386.       SetWindowModes(CursorOffMode) ;
  387.       MakeWindow(0,0,22,68,Black+LightGrayBG,Black+LightGrayBG,SingleBrdr,Window1) ;
  388.       TitleWindow(Top,Center,Black+LightGrayBG,' TIP Monitor Analysis Program HELP! ') ;
  389.       TitleWindow(Bottom,Left,Black+LightGrayBG,' Directory window ') ;
  390.       AccessWindow(Window1) ;
  391.       WWrite ( 2,2,'The following keys are active:') ;
  392.       With TopWndwStat do begin
  393.          WndwAttr := LightCyan+LightGrayBG ;
  394.          WWrite ( 3,4,chr(24)+chr(27)) ;
  395.          WndwAttr := OrigAttr ;
  396.          WWrite ( 3,17,'move the selector up one file') ;
  397.  
  398.          WndwAttr := LightCyan+LightGrayBG ;
  399.          WWrite ( 4,4,chr(25)+chr(26)) ;
  400.          WndwAttr := OrigAttr ;
  401.          WWrite ( 4,17,'move the selector down one file') ;
  402.  
  403.          WndwAttr := LightCyan+LightGrayBG ;
  404.          WWrite ( 6,4,'PgUp') ;
  405.          WndwAttr := OrigAttr ;
  406.          WWrite ( 6,17,'moves the selector up one screenful') ;
  407.  
  408.          WndwAttr := LightCyan+LightGrayBG ;
  409.          WWrite ( 7,4,'PgDn') ;
  410.          WndwAttr := OrigAttr ;
  411.          WWrite ( 7,17,'moves the selector down one screenful') ;
  412.  
  413.          WndwAttr := LightCyan+LightGrayBG ;
  414.          WWrite ( 9,4,'Home') ;
  415.          WndwAttr := OrigAttr ;
  416.          WWrite ( 9,17,'moves the selector to the top of the screen') ;
  417.  
  418.          WndwAttr := LightCyan+LightGrayBG ;
  419.          WWrite (10,4,'End ') ;
  420.          WndwAttr := OrigAttr ;
  421.          WWrite (10,17,'moves the selector to the bottom of the screen') ;
  422.  
  423.          WndwAttr := LightCyan+LightGrayBG ;
  424.          WWrite (12,4,'Ctrl-Home ') ;
  425.          WndwAttr := OrigAttr ;
  426.          WWrite (12,17,'moves the selector to the top of the directory') ;
  427.  
  428.          WndwAttr := LightCyan+LightGrayBG ;
  429.          WWrite (13,4,'Ctrl-End ') ;
  430.          WndwAttr := OrigAttr ;
  431.          WWrite (13,17,'moves the selector to the bottom of the directory') ;
  432.  
  433.          WndwAttr := LightCyan+LightGrayBG ;
  434.          WWrite (15,4,'Ctrl- '+chr(27)+chr(24)+chr(26)+chr(25)) ;
  435.          WndwAttr := OrigAttr ;
  436.          WWrite (15,17,'moves the window') ;
  437.  
  438.          WndwAttr := LightCyan+LightGrayBG ;
  439.          WWrite (16,4,'Alt - '+chr(27)+chr(26)) ;
  440.          WndwAttr := OrigAttr ;
  441.          WWrite (16,17,'resizes the window') ;
  442.  
  443.          WndwAttr := LightCyan+LightGrayBG ;
  444.          WWrite (18,4,'Return') ;
  445.          QWriteEOS (OrigAttr,'/') ;
  446.          QWriteEOS (LightCyan+LightGrayBG,'Enter ') ;
  447.          WndwAttr := OrigAttr ;
  448.          WWrite (18,17,'selects a file, or changes drive/directory') ;
  449.  
  450.          WndwAttr := LightCyan+LightGrayBG ;
  451.          WWrite (19,4,'Esc ') ;
  452.          WndwAttr := OrigAttr ;
  453.          WWrite (19,17,'Escapes without selecting a file') ;
  454.  
  455.          end ;
  456.  
  457.       key := Readkey ;
  458.       if key = #0 then key := Readkey ;
  459.       RemoveWindow ;
  460.       WGotoRC(Row,Col) ;
  461.  
  462.    end ;
  463.  
  464.  
  465.    Procedure GetResponse (NumFil:integer) ;
  466.       { get and respond to keys to manipulate the display list }
  467.  
  468.       var
  469.          error           : Boolean ; { error flag when reading drives }
  470.          FNTickNew,
  471.          FNTick          : real ;    { number 1..wh that shows how many files }
  472.          i               : integer ; { window relative physical display line # }
  473.          TempStr,
  474.          TempSt2         : string[80] ;
  475.  
  476.    begin
  477.       i := 1 ;                              { start at first file in display }
  478.       GoodKey := true ;
  479.       FNTick := 2 ;                         { initial position for file postion tick }
  480.       Repeat
  481.          WriteToVirtual(aWindow) ;          { in case window moved }
  482.          QAttr(i,2,1,ww-4,White+CyanBG) ;   { highlight the current file in question }
  483.          VUpdateWindow ;                    { update window on CRT }
  484.          WriteToCRT ;
  485.          if (TotalDirFiles <= wh-3) then begin
  486.             if (FNTick <> (wh-3)) then begin
  487.                WBrdrPart(trunc(FNTick),ww-1,BrdrLV) ; { restore the vertical line }
  488.                FNTick := wh-2 ;
  489.                WBrdrPart(trunc(FNTick),ww-1,BrdrCL) ;  { draw a cross }
  490.                end ;
  491.             end
  492.          else begin
  493.             FNTickNew := (((FileOffset+i-1) / TotalDirFiles) * (wh-3)) + 1 ;
  494.             if (FNTick <> FNTickNew) then begin
  495.                WBrdrPart(trunc(FNTick),ww-1,BrdrLV) ; { restore the vertical line }
  496.                FNTick := FNTickNew ;
  497.                WBrdrPart(trunc(FNTick),ww-1,BrdrCL) ; { draw a cross }
  498.                end ;
  499.             end ;
  500.          GetKeyDos ;                        { get a key from user using Dos }
  501.          WriteToVirtual(aWindow) ;
  502.          QAttr(i,2,1,ww-4,LightCyan+LightGrayBG) ; { remove highlight }
  503.          if ExtKey then case Ord(Key) of   { if extended key...}
  504.             Home       : i := 1 ;          { HOME key goes to top of screen }
  505.             EndKey     : i := NumFil ;     { END key goes to bottom }
  506.             PgDn       : begin             { PgDn key scrolls down a page if possible }
  507.                             if (TotalDirFiles > (wh-3)) AND (FileOffset+wh+1 < TotalDirFiles) then begin
  508.                                WClrScr ;
  509.                                FileOffset := MinI(TotalDirFiles-(wh-3),FileOffset+(wh-3)) ;
  510.                                DisplaySome(FileOffset) ;
  511.                                end
  512.                             else i := NumFil ;
  513.                             end ;
  514.             PgUp       : begin                        { PgUp key scrolls up one page if possible }
  515.                             if (FileOffset > 1) then begin
  516.                                WClrScr ;
  517.                                FileOffset := MaxI(FileOffset-(wh-3),1) ;
  518.                                DisplaySome(FileOffset) ;
  519.                                end
  520.                             else i := 1 ;
  521.                             end ;
  522.             CtrlHome,
  523.             CtrlPgUp   : begin                        { Goto first file in list, scrolling if necessary }
  524.                             if (FileOffset > 1) then begin
  525.                                WClrScr ;
  526.                                FileOffset := 1 ;
  527.                                DisplaySome(FileOffset) ;
  528.                                end ;
  529.                             i := 1 ;
  530.                             end ;
  531.             CtrlEnd,
  532.             CtrlPgDn   : begin                        { Goto last file in list, scrolling if necessary }
  533.                             if (TotalDirFiles > (wh-2)) AND (FileOffset+wh+1 < TotalDirFiles) then begin
  534.                                WClrScr ;
  535.                                FileOffset := TotalDirFiles-(wh-3) ;
  536.                                DisplaySome(FileOffset) ;
  537.                                end ;
  538.                             i := NumFil ;
  539.                             end ;
  540.             LeftArrow,   { and scroll if necessary }
  541.             UpArrow    : if (i > 1) then dec(i)
  542.                             else if (TotalDirFiles > wh-2) AND
  543.                                     (FileOffset > 1) then
  544.                                ScrollDown ;
  545.             RightArrow,  { and scroll if necessary }
  546.             DownArrow  : if (i < NumFil) then inc(i)
  547.                             else if (TotalDirFiles > wh-3) AND
  548.                                     (FileOffset+wh-3 < TotalDirFiles) then
  549.                                ScrollUp ;
  550.             AltLeftArrow : if (TVS.WSCol2-TVS.WSCol >= 16) then begin
  551.                               dec(ww) ;
  552.                               VResizeWindow(0,-1);
  553.                               WBrdrPart(trunc(FNTick),ww-1,BrdrCL) ; { draw a cross }
  554.                               end ;
  555.             AltRightArrow : if (TVS.WSCol2-TVS.WSCol < 49) then
  556.                                if (TVS.WSCol2 < 78) then begin
  557.                                   inc(ww) ;
  558.                                   VResizeWindow(0,1);
  559.                                   WBrdrPart(trunc(FNTick),ww-1,BrdrCL) ; { draw a cross }
  560.                                   end
  561.                                else begin
  562.                                   dec(wl) ;
  563.                                   MoveWindow(0,-1) ;
  564.                                   inc(ww) ;
  565.                                   VResizeWindow(0,1);
  566.                                   WBrdrPart(trunc(FNTick),ww-1,BrdrCL) ; { draw a cross }
  567.                                   end ;
  568.             CtrlLeftArrow  : if (TVS.WSCol > 1) then begin
  569.                                 dec(wl) ;
  570.                                 MoveWindow(0,-1) ;
  571.                                 end ;
  572.             CtrlRightArrow : if (TVS.WSCol2 < 78) then begin
  573.                                 inc(wl) ;
  574.                                 MoveWindow(0,1) ;
  575.                                 end ;
  576.             CtrlUpArrow    : if (TVS.WSRow > 1) then begin
  577.                                 dec(wt) ;
  578.                                 MoveWindow(-1,0) ;
  579.                                 end ;
  580.             CtrlDownArrow  : if (TVS.WSRow2 < 24) then begin
  581.                                 inc(wt) ;
  582.                                 MoveWindow(1,0) ;
  583.                                 end ;
  584.             AltHome        : begin
  585.                                 MoveWindow(-wt,-wl) ;
  586.                                 wl := 1 ;
  587.                                 wt := 1 ;
  588.                                 end ;
  589.             AltEnd         : begin
  590.                                 MoveWindow(25 - (wt + wh), 80 - (wl + ww + 1)) ;
  591.                                 wl := 80 - (ww + 1) ;
  592.                                 wt := 25 - wh ;
  593.                                 end ;
  594.             F1             : begin
  595. { comment out until get full windows package!!!
  596.                                 WriteToCRT ;
  597.                                 DirectoryHelp ;
  598.                                 WriteToVirtual (aWindow) ;
  599. }
  600.                                 end ;
  601.             end
  602.          else case Key of
  603.             RetKey     : begin       { <RET> key either selects this file or moves between directories }
  604.                             with FilPtrs[i+FileOffset-1]^ do begin
  605.                                if (Attr = Directory) then begin
  606.                                   GetSubName(FExpand('')) ;
  607.                                   WClrTitle(Top) ;
  608.                                   if (pos(':',Name) = 0) then      { if not changing drives }
  609.                                      ChDir(FExpand('')+Name)  {  then do a cd }
  610.                                   else begin          {  else log on to new drive }
  611.                                      key := chr($0) ;
  612.                                      Repeat
  613.                                         Error := false ;
  614.                                         R.AH := $1C ;
  615.                                         R.DL := Ord(name[1])-64 ;
  616.                                         Intr($21,R) ;
  617.                                         if (R.AL = 255) then begin
  618.                                            Error := true ;
  619.                                            if (MSDosVersion > 3.0) then ShowDos3xError(Name)
  620.                                            else ShowDos2xError(name) ;
  621.                                            end ;
  622.                                      Until (Error = false) OR (key = EscKey) ;
  623.                                      if key <> EscKey then begin
  624.                                         ChDir(Name) ;
  625.                                         if (DosError <> 0) AND (DosError <> 18) then
  626.                                            ShowErrorMessage(DosErrorMsg(DosError)) ;
  627.                                         ErrorCode := IOResult ;
  628.                                         if (ErrorCode <> 0) AND (ErrorCode <> 18) then
  629.                                            ShowErrorMessage(IOResultMsg(ErrorCode)) ;
  630.                                         end ;
  631.                                      end ;
  632.                                   TitleWindow(Top,Left,Blue+LightGrayBG,' '+FExpand('')+' ') ;
  633.                                   ReleaseFilePtrs ;
  634.                                   GetFileList(FExpand('')) ;
  635.                                   WClrScr ;
  636.                                   FileOffset := 1 ;      { display some files beginning with first one }
  637.                                   DisplaySome(FileOffset) ;
  638.                                   NumFil := FNum ;
  639.                                   i := Suboffset ;
  640.                                   end
  641.                                else begin
  642.                                   FilName := Name ;
  643.                                   GoodKey := false ;
  644.                                   end ;
  645.                                end ; {with}
  646.                             end ;
  647.             EscKey     : begin
  648.                             GoodKey := false ;
  649.                             end ;
  650.             end ;
  651.       Until (GoodKey = false) ;
  652.    end ;
  653.  
  654.  
  655. begin  { DisplayList }
  656.    FilName := '' ;
  657.    VerifyParamters (wt,wl,wh,ww) ;
  658.    SetWindowModes(VirtualMode+ZoomMode+ShadowRight+CursorOffMode) ;
  659.    MakeWindow(wt,wl,wh,ww,LightCyan+LightGrayBG,Blue+LightGrayBG,DoubleBrdr,aWindow) ;
  660.    WriteToVirtual(aWindow) ;
  661.    TitleWindow(Top,Left,Blue+LightGrayBG,' '+FExpand('')+' ') ;
  662.    TitleWindow(Bottom,Left,Blue+LightGrayBG,' Use '+chr(24)+chr(25)+' keys, then <RET> to select file ') ;
  663.    WClrScr ;
  664.    FileOffset := 1 ;
  665.    FNum := 1 ;
  666.    FindDrives ;                { get list of available drives }
  667.    GetFileList (FExpand('')) ; { get list of files in this directory }
  668.    DisplaySome(FileOffset) ;   { display the directory, or the first screenful }
  669.    GetResponse(FNum) ;         { get user responses and respond accordingly }
  670.    ReleaseFilePtrs ;
  671.    RemoveWindow ;
  672. end ;  { DisplayList }
  673.  
  674. end.